perm filename HOUSES[L70,TES] blob sn#032111 filedate 1973-03-27 generic text, type T, neo UTF8
00010	EXPR CHOICE(N) ;
00020	   SELECT II FROM II:1 SUCCESSOR II+1 UNLESS II GREATERP N FINALLY FAILURE();
00030	
00100	EXPR SOLVE() ;
00200	BEGIN
00300	HOUSES ← '(H1 H2 H3 H4 H5) ;
00400	FOR NEW I ← 1 TO 5 DO HOUSES[I].NUM ← I ;
00500	INHOUSE('H1, 'NORWEGIAN, 'NATIONALITY) ;
00600	INHOUSE('H2, 'BLUE, 'COLOR) ;
00700	INHOUSE('H3, 'MILK, 'DRINK) ;
00800	PLACE('ENGLISH,'NATIONALITY,'RED,'COLOR) ;
00900	PLACE('SPANISH,'NATIONALITY,'DOG,'PET) ;
01000	PLACE('COFFEE,'DRINK,'GREEN,'COLOR) ;
01100	PLACE('UKRAINE,'NATIONALITY,'TEA,'DRINK) ;
01200	ADJACENT('GREEN,'COLOR,'IVORY,'COLOR,'(RIGHT)) ;
01300	PLACE('OLDGOLD,'CIGARETTE,'SNAILS,'PET) ;
01400	PLACE('KOOLS,'CIGARETTE,'YELLOW,'COLOR) ;
01500	ADJACENT('CHESTERFIELD,'CIGARETTE,'FOX,'PET,'(LEFT RIGHT)) ;
01600	ADJACENT('KOOLS,'CIGARETTE,'HORSE,'PET,'(LEFT RIGHT)) ;
01700	PLACE('LUCKYSTRIKE,'CIGARETTE,'ORANGEJUICE,'DRINK) ;
01800	PLACE('JAPANESE,'NATIONALITY,'PARLIAMENT,'CIGARETTE) ;
01900	PRINT(<WHERENO('DRINK).NATIONALITY, 'DRINKS, 'WATER>) ;
02000	PRINT(<WHERENO('PET).NATIONALITY, 'OWNS, 'A, 'ZEBRA>) ;
02100	END ;
02200	
02300	EXPR WHERENO(ATTRIBUTE) ;
02400	BEGIN
02500	NEW H ;
02600	H ← HOUSES[CHOICE(5)] ;
02700	IF H.(ATTRIBUTE) THEN FAILURE() ;
02800	RETURN H ;
02900	END ;
03000	
03100	EXPR WHERENOS(ATTRIBUTE1,ATTRIBUTE2) ;
03200	BEGIN
03300	NEW H ;
03400	H ← HOUSES[CHOICE(5)] ;
03500	IF H.(ATTRIBUTE1) OR H.(ATTRIBUTE2) THEN FAILURE() ;
03600	RETURN H ;
03700	END ;
03800	
03900	EXPR INHOUSE(H, VAL, ATTR) ;
04000	BEGIN
04100	IF H.(ATTR) THEN
04200	   IF H.(ATTR) EQ VAL THEN NIL
04300	   ELSE FAILURE()
04400	ELSE H.(ATTR) ← VAL ALSO VAL.HOUSE ← H ;
04500	END ;
04600	
04700	EXPR PLACE(V1, A1, V2, A2) ;
04800	BEGIN
04900	NEW HA, HB ;
05000	HA ← A1.HOUSE ; HB ← A2.HOUSE ;
05100	IF HA THEN
05200	   IF HB THEN
05300	      IF HA EQ HB THEN NIL
05400	      ELSE FAILURE()
05500	   ELSE INHOUSE(HA, V2, A2)
05600	ELSE IF HB THEN INHOUSE(HB, V1, A1)
05700	ELSE HA ← WHERENOS(A1, A2) ALSO
05800	   INHOUSE(HA, V1, A1) ALSO
05900	   INHOUSE(HA, V2, A2) ;
06000	END ;
06100	
06200	EXPR ADJACENT(V1, A1, V2, A2, W) ;
06300	BEGIN
06400	NEW HA, HB ;
06500	HA ← A1.HOUSE ; HB ← A2.HOUSE ;
06600	IF HA THEN
06700	   IF HB THEN
06800	      IF ADJ(HA,HB,W) THEN NIL
06900	      ELSE FAILURE()
07000	   ELSE PUTADJ(HA,V2,A2,W)
07100	ELSE IF HB THEN PUTADJ(HB,V1,A1,IF W='(LEFT) THEN '(RIGHT) ELSE IF W='(RIGHT) THEN '(LEFT) ELSE W)
07200	ELSE HA ← WHERENO(A1) ALSO PUTADJ(HA,V2,A2,W)
07300	   ALSO INHOUSE(HA, V1, A1) ;
07400	END ;
07500	
07600	EXPR ADJ(HA, HB, W) ;
07700	   BEGIN
07800	   IF 'LEFT MEMQ W AND HA.NUM+1=HB.NUM THEN RETURN T ;
07900	   IF 'RIGHT MEMQ W AND HA.NUM-1=HB.NUM THEN RETURN T ;
08000	   RETURN NIL ;
08100	   END ;
08200	
08300	EXPR PUTADJ(HA, V, A, W) ;
08400	   BEGIN
08500	   NEW HB ;
08600	   HB ← IF LENGTH(W)=2 THEN HA.NUM+(IF CHOICE(2)=1 THEN 1 ELSE -1)
08700	   ELSE IF W EQ '(LEFT) THEN HA.NUM+1
08800	   ELSE HA.NUM-1 ;
08900	   IF HB LESSP 1 OR HB GREATERP 5 THEN FAILURE() ;
09000	   HB ← HOUSES[HB] ;
09100	   INHOUSE(HB, V, A) ;
09200	   END ;
09300	
09310	_EOF_